home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / dialogsNew.tcl < prev    next >
Encoding:
Text File  |  2000-12-19  |  10.5 KB  |  325 lines
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "dialogsNew.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 12/19/2000 {13:23:32 PM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <vince@santafe.edu>
  10.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501
  11.  #     www: <http://www.santafe.edu/~vince/>
  12.  #  
  13.  # Copyright (c) 1997-2000  Vince Darley, 
  14.  # Distributed under Tcl style free license.
  15.  # ###################################################################
  16.  ##
  17.  
  18. namespace eval dialog {}
  19.  
  20. ensureset dialog::_not_global_flag ""
  21.  
  22. ## 
  23.  # -------------------------------------------------------------------------
  24.  # 
  25.  # "dialog::make" --
  26.  # 
  27.  #  General purpose single/multi page dialog creator.  Optional flags
  28.  #  at start of arguments list include:
  29.  #  
  30.  #  -title "Dialog title"
  31.  #  -defaultpage "Page name"
  32.  #  -ok "name of ok button"
  33.  #  -cancel "name of cancel button"
  34.  #  -addbuttons [list name1 help1 script1 name2 ...]
  35.  #  
  36.  #  Each of the remaining arguments is a list, starting with the name
  37.  #  of the page represented by that list, and followed by sublists for
  38.  #  each dialog item.  Currently each such sublist is a triplet of
  39.  #  the form 'type name value'.  An optional 4th item in the sublist
  40.  #  is the help text for that item.  So,
  41.  #  
  42.  #  dialog::make -ok "Accept" -title hello -defaultpage Second \
  43.  #    {First {var Hey 1} {flag blah 0} {Folder hey ""}} {Second {var Hey 2}}
  44.  #    
  45.  #  Will create a dialog with two pages, named 'First' and 'Second'.
  46.  #  The first page contains 3 dialog items: a variable, a flag and a
  47.  #  folder item.  These are 'named' Hey, blah and hey respectively,
  48.  #  and have current values 1, 0, and "" respectively.  The second
  49.  #  page contains a single variable to be edited.
  50.  #  
  51.  #  This procedure returns a list of the final edited values of the
  52.  #  dialog items (just a flat list), or returns an error if the
  53.  #  dialog was cancelled.
  54.  #  
  55.  #  Unlike most of Alpha's dialog procedures, this one doesn't 
  56.  #  actually modify any variable values in place.  It is simply
  57.  #  a nice wrapper around the rather cumbersome core 'dialog' command,
  58.  #  which solves all the hassle of funny dialog item types
  59.  #  (particularly folders, paths, files, popup menus etc...).
  60.  #  It is up to the caller to take the returned values and store
  61.  #  the changes as appropriate.
  62.  #  
  63.  #  THIS PROC IS NOT YET REENTRANT, therefore do not use button-scripts
  64.  #  which might call this procedure to generate new recursive dialogs.
  65.  # -------------------------------------------------------------------------
  66.  ##
  67. proc dialog::make {args} {
  68.     dialog::resetModified
  69.     global dialog::_tmp dialog::_not_global_flag
  70.     if {[info exists dialog::_tmp]} {
  71.     # This shouldn't exist.  The dialog must have failed last time.
  72.     # During beta releases, we will ask the user to submit a bug
  73.     # report.
  74.     alertnote "The 'dialog::make' command failed with an internal error\
  75.       last time you used it.  Please try to isolate the circumstances of\
  76.       the bug and then submit a bug report to the Alpha-D\
  77.       mailing list"
  78.     }
  79.     set opts(-ok) OK
  80.     set opts(-cancel) Cancel
  81.     getOpts {-title -defaultpage -ok -cancel -addbuttons}
  82.     set dialog::_not_global_flag dialog::_tmp
  83.     # If we were given an empty dialog, return an empty result
  84.     if {[llength $args] == 0} {return ""}
  85.     # We need to loop to cope with the user pressing 'set...' buttons
  86.     # which modify the dialog without exiting.  Alpha8/Tk can cope with
  87.     # set... buttons in place, so we could then remove the loop.
  88.     while {1} {
  89.     set x 10
  90.     set ymax 0
  91.     set dialog {}
  92.     set items {}
  93.     if {[llength $args] == 1} {
  94.         set multipage 0
  95.     } else {
  96.         set multipage 1
  97.     }
  98.     foreach page $args {
  99.         set pageName [lindex $page 0]
  100.         lappend names $pageName
  101.         if {$multipage} {
  102.         lappend dialog -n $pageName
  103.         }
  104.         set y 50
  105.         eval lappend dialog [eval [list dialog::makeFromItems $x y items] $page]
  106.         if {$y > $ymax} {set ymax $y}
  107.     }
  108.     incr ymax 10
  109.     set y $ymax
  110.     if {![info exists opts(-defaultpage)]} {
  111.         set opts(-defaultpage) [lindex $names 0]
  112.     }
  113.     if {![info exists opts(-title)]} { set opts(-title) "" }
  114.     
  115.     set button_help {}
  116.     if {[info exists opts(-addbuttons)]} {
  117.         set numbuttons 0
  118.         set button_press {}
  119.         set b_args {}
  120.         set x 10
  121.         newforeach {button bh bproc} [concat \
  122.           [list $opts(-ok) "Click here to save the current settings." "" \
  123.           $opts(-cancel) "Click here to discard any changes you've made to the settings." ""] \
  124.           $opts(-addbuttons)] {
  125.         lappend b_args $button "" y
  126.         lappend button_help $bh
  127.         lappend button_press $bproc
  128.         incr numbuttons
  129.         }
  130.         set buttons [eval dialog::button $b_args]
  131.     } else {
  132.         set buttons [dialog::okcancel 10 y 0 $opts(-ok) $opts(-cancel)]
  133.         set numbuttons 2
  134.         lappend button_help \
  135.           "Click here to save the current settings." \
  136.           "Click here to discard any changes you've made to the settings."
  137.     }
  138.     
  139.     set dialog [concat $buttons $dialog]
  140.     set help {}
  141.     if {$multipage} {
  142.         lappend help "Use this popup menu, or the cursor keys to select a \
  143.           different page of preferences."
  144.         set mnames [concat [list $opts(-defaultpage)] $names]
  145.         set dialog [concat [list -m $mnames 100 20 300 40] $dialog]
  146.     } else {
  147.         set dialog [concat [list -t [lindex $names 0] 100 20 300 40] $dialog]
  148.     }
  149.     eval lappend help $button_help
  150.     foreach it $items {
  151.         lappend help [lindex $it 3]
  152.     }
  153.     if {[info tclversion] >= 8.0} {
  154.         # Alpha 7.x doesn't support the '-help' flag.
  155.         set dialog [concat $dialog [list -help $help]]
  156.     }
  157.     if {[info tclversion] < 8.0} {
  158.         if {[catch {eval [list dialog -w 400 -h $y] $dialog} res]} {
  159.         # bug in internal 'dialog' command
  160.         unset dialog::_tmp
  161.         set dialog::_not_global_flag ""
  162.         dialog::resetModified
  163.         alertnote "Sorry, you encountered a bug in Alpha 7's 'dialog' command, \
  164.           which cannot handle very complex dialogs.  If you are trying to edit\
  165.           many items at once, try to edit them just one at a time."
  166.         error "Internal bug in 'dialog'."
  167.         }
  168.     } else {
  169.         set res [eval [list dialog -w 400 -h $y -T $opts(-title)] $dialog]
  170.     }
  171.     if {!$multipage} {
  172.         # Pretend there is a 'page' result.
  173.         set res [concat [list [lindex $names 0]] $res]
  174.     }
  175.     if {[lindex $res 2]} {
  176.         # Cancel
  177.         set retCode 1 ; set retVal "Cancelled!"
  178.     } else {
  179.         if {[lindex $res 1]} {
  180.         # Ok
  181.         set retCode 0
  182.         }
  183.         set retVal {}
  184.         # Get all new values, possibly checking for 'set…' button presses
  185.         set count 3
  186.         if {$numbuttons > 2} {
  187.         while {$count <= $numbuttons} {
  188.             if {[lindex $res $count]} {
  189.             set pressScript [lindex $button_press [expr {$count -1}]]
  190.             catch {eval $pressScript}
  191.             }
  192.             incr count
  193.         }
  194.         }
  195.         
  196.         foreach ii $items {
  197.         newforeach {type page name} $ii {break}
  198.         switch -- $type {
  199.              Folder - Path {
  200.              if {[lindex $res $count] == 1} {
  201.                  if {![catch {get_directory -p "New [lrange $ii 1 end]"} newval]} {
  202.                  dialog::modified "$page,$name" $newval Folder
  203.                  set dialog::_tmp($page,$name) [dialog::getFlag "$page,$name"]
  204.                  }
  205.              }
  206.             }
  207.             file {
  208.              if {[lindex $res $count] == 1} {
  209.                  set oldval [dialog::getFlag "$page,$name"]
  210.                  if {![catch {getfile [quote::Prettify "New [lrange $ii 1 end]"] $oldval} newval] \
  211.                    && $oldval != $newval} {
  212.                   dialog::modified "$page,$name" $newval file
  213.                   set dialog::_tmp($page,$name) [dialog::getFlag "$page,$name"]
  214.                  }
  215.              }
  216.             }
  217.             default {
  218.             dialog::modified "$page,$name" [lindex $res $count]
  219.             set dialog::_tmp($page,$name) [dialog::getFlag "$page,$name"]
  220.             }
  221.         }
  222.         incr count
  223.         lappend retVal [dialog::getFlag "$page,$name"]
  224.         }
  225.     }
  226.     # remember the current page
  227.     set opts(-defaultpage) [lindex $res 0]
  228.     if {[info exists retCode]} {break}
  229.     }
  230.     unset dialog::_tmp
  231.     set dialog::_not_global_flag ""
  232.     dialog::resetModified
  233.     return -code $retCode $retVal
  234. }
  235.  
  236. proc dialog::makeFromItems {x yy items page args} {
  237.     global dialog::_tmp
  238.     upvar $yy y
  239.     upvar $items item
  240.     set res {}
  241.     foreach itemset $args {
  242.     newforeach {type name val help} $itemset {break}
  243.     if {![info exists dialog::_tmp($page,$name)]} {
  244.         set dialog::_tmp($page,$name) $val
  245.     } else {
  246.         set val [set dialog::_tmp($page,$name)]
  247.     }
  248.     eval lappend res [dialog::makeItem $type $x y $page $name $val $help]
  249.     lappend item [list $type $page $name $help]
  250.     }
  251.     set res
  252. }
  253.  
  254. # In need of some work filling in other types
  255. proc dialog::makeItem {type x yy page name val {help ""}} {
  256.     set res {}
  257.     upvar $yy y
  258.     if {[llength $type] > 1} {
  259.     switch -- [lindex $type 0] {
  260.         "global" {
  261.         set v [lindex $type 1]
  262.         global flag::list
  263.         if {[info exists flag::list($v)]} {
  264.             set litems [flag::options $v]
  265.             if {[regexp "index" [lindex [set flag::list($v)] 0]]} {
  266.             # set item to index, making sure bad values don't error
  267.             if {[catch {lindex $litems $val} val]} { set val [lindex $litems 0] }
  268.             }
  269.             eval lappend res [dialog::text $name $x y 30]
  270.             eval lappend res [dialog::menu $x y $litems $val]
  271.         } elseif {[regexp "Colou?r$" $v]} {
  272.             global alpha::colors
  273.             eval lappend res [dialog::text $name $x y 30]
  274.             eval lappend res [dialog::menu $x y ${alpha::colors} $val]
  275.         } elseif {[regexp "Mode$" $v]} {
  276.             if {$val == ""} { set val "<none>" }
  277.             eval lappend res [dialog::text $name $x y 30]
  278.             eval lappend res [dialog::menu $x y [concat "<none>" [mode::listAll]] $val]
  279.         } else {
  280.             eval lappend res [dialog::textedit $name $val $x y 30]
  281.         }
  282.         }
  283.         "menu" {
  284.         set items [lindex $type 1]
  285.         eval lappend res [dialog::text $name $x y 20] \
  286.           [dialog::menu 120 y $items $val]
  287.         }
  288.         default {
  289.         error "Unsupported $type"
  290.         }
  291.     }
  292.     } else {
  293.     switch -- $type {
  294.         "flag" {
  295.         eval lappend res [dialog::checkbox $name $val $x y]
  296.         }
  297.         "Folder" {
  298.         eval lappend res [dialog::text $name $x y 20]
  299.         set vv [dialog::specialView::file $val]
  300.         lappend res "-t" $vv $x $y [expr {$x + 250}] [expr {$y + 18}]
  301.         eval lappend res [dialog::buttonSet [expr {$x + 250}] $y Folder "$page,$name"]
  302.         incr y 18
  303.         }
  304.         "file" {
  305.         eval lappend res [dialog::text $name $x y 20]
  306.         set vv [dialog::specialView::file $val]
  307.         lappend res "-t" $vv $x $y [expr {$x + 250}] [expr {$y + 18}]
  308.         eval lappend res [dialog::buttonSet [expr {$x + 250}] $y file "$page,$name"]
  309.         incr y 18
  310.         }
  311.         "password" {
  312.         eval lappend res [dialog::text $name $x y 20]
  313.         lappend res "-e" $val $x $y [expr {$x + 100}] [expr {$y+2}]
  314.         incr y 18
  315.         }
  316.         default {
  317.         eval lappend res [dialog::textedit $name $val $x y 30]
  318.         }
  319.     }
  320.     }
  321.     set res
  322. }
  323.  
  324.  
  325.